This is a list of useful examples of perl showing how to use the language in various cases. This document is a quick introduction to perl programming concerning how the language could be used in real world cases.
In some cases the samples are taken directly from the Camel book. In some cases the snippets are mine, sometimes they are entries based on postings on the comp.lang.perl.* newsgroups.
Send suggestions, comments, bug reports and such to:
Kent Sandvik, sandvik@sgi.com.$value = 42; # integer $pi = 3.1415; # numeric $hex = 0xffff; # hex $octal = 0377; # octal $num = 6.02e23; # scientific notation $pet = 'dog'; # string $sign = "Beware of $pet\n"; # string with interpolation $curdir = `pwd`; # command
$string = "hello " . "world"; print $string; # hello world $float = "." . "03"; print $float; # concatenation to a float number
$record ="01234567890123456789xxxxxxxxxxx1234567890";
$from1to10 = substr($record,0,10); # first ten characters
$from21to30 = substr($record,20,10); # from offset 20 with 10 characters
$name = "test";
# append at beginning ("The test")
substr($name, 0, 0) = "The ";
# replace first char with string ("This is the test")
substr($name, 0, 1) = "This is t";
# replace last char with string ("This is the test here!")
substr($name, -1, 1) = "t here!";
# remove the last six characters ("This is the test")
substr($name, -6) = '';
# Note that $[ defines the offset (default 0)
$record ="field1field2f3thisisfield4";
$_ = $record;
($f1, $f2, $f3, $f4) = unpack("A6 A6 A2 A12",$record);
# or
($f1, $f2, $f3, $f4) = /(......)(......)(..)(............)/;
# or
($f1, $f2, $f3, $f4) = /(.{6})(.{6})(.{2})(.{12})/;
print $f1, " ", $f2, " ", $f3, " ", $f4, "\n"; # field1 field2 f3 thisisfield4
@alphabet = ('A' .. 'Z'); print @alphabet;
print ('aa' .. 'zz');
@growing_things =('oats', 'peas', 'beans', 'barley');
print $growing_things[1]; # second element (peas)
print @growing_things[2 .. 4]; # selection (beansbarley)
print sort @growing_things; # operation on array (barleybeansoatspeas)
print grep (/ea/, @growing_things); # grep from array (peasbeans)
@count = (1,2,3,4,5,6,7,8,9,10);
@another_count = (1 .. 10);
$val = 1; $string = 'foo'; $float = 3.14;
@array =($val, $string, $float);
($red, $green, $blue) = (0 .. 2); ($a[2], $a[0], $a[3], $a[1]) = @growing_things; # array slice ($name, $pw, $uid, $gid, $gcos, $home, $shell) = split(/:/, PASSWD);
@a = (1 .. 3); @b = (0, @a, 4); # (0, 1, 2, 3, 4) @c = (); # null list @d = (0, @c, 4); # (0, 4) @array = (1 .. 3); @array = (@array, @array); # append array to itself push(@array, @array); # append array to itself
@array = (1,2,3,4,5,6); # Note, $# is the notation for last array element. @array = @array[$#array-4 ..$#array]; # slice out last five items print @array;
Check what elements in two arrays are the same, and what elements are not the same.
@rollerskaters =('adam', 'dale','jodee', 'marjii', 'merlyn');
@pilots = ('geoff', 'jim', 'merlyn', 'rick');
local(%mark);
grep($mark{$_}++, @rollerskaters);
@nonskatingpilots = grep(!$mark{$_}, @pilots);
@skatingpilots = grep($mark{$_}, @pilots);
print "@nonskatingpilots\n"; print "@skatingpilots\n";
@array = (1, 2, 3, 4);
# Make a temporary change in array
{
local (@array) = @array;
$array[0] = 99;
print "local array = @array\n";
}
print "global array = @array\n";
%map = ('red', 0x000f, 'blue', 0x0f00, 'green', 0x0f00);
foreach $key (keys %map) {
print $key , ' = ', $map{$key}, "\n";
}
@keys = (1,2,3,4,5);
@contents = ("one", "two", "three", "four", "five");
# If arrays are of the same lenght, slice them for the associative array.
@assoc{@keys} = @contents;
foreach $item (1,2,1,2,3,4,3) {
push(@array, $item) unless $haveseen{$item}++;
}
print @array; #1234
@list = ("This", "is" ,"an", "arbitrary", "list");
foreach $entry (@list){
if ($entry =~/is/){
print "$entry "; # This is list
}
}
print "Hello, World";
$camels = "123"; print $camels + 1, "\n";
print '-' x 72; # 72 - in a row
$file = "Foo"; open(THEFILE,"> $file") || die "Couldn't open $file: $!\n"; # > create file if it does not exist # >> always append to file print THEFILE "Hello, World\n"; print THEFILE "The End.\n"; close(THEFILE);
$^I = ".bak"; # enable inline editing, rename the original files
@ARGV=("x", "y", "z"); # these are the names of the files to be edited
while(<>){
s/line/Line/g;
print;
}
# This is an oneliner doing the similar thing
perl -pi.bak -e 's/line/Line/g' x y z
for($i = 1; $i < 10; $i++) {
print $i;
}
for (101 .. 200){
print;
}
&foo;
sub foo {
print "Hello";
}
&foo(42, "Hello");
sub foo {
local ($val, $string) = @_;
print $val;
print $string;
}
$little_program = 'print "Howdy, world\n";'; eval $little_program; $other_program = <<'End_of_program'; print "Howdy world again\n"; End_of_program eval $other_program;
while (<>) {
if (/^extern/ || /^enum/) {
print;
}
}
# Another variant.
print if /\btypedef struct\b/;
s/\binstance\b/the instance/g;
$string = "String with blank end "; $string =~s/ +$//; # substitute one or more spaces at the end with nothing (//)
s/#.*$//g
s/^\s*(.*)\s*$/\1/
\s = any whitespace char, \S = any non-whitespace char
(\S+)\s = place all first non-space chars followed by space into $1
(\S+) = place the following all non-spacechars into $2
$line = "This is an arbitrary line";
if ($line =~ /(\S+)\s+(\S+)/) {
print "First word = $1, ";
print "Second word = $2.\n";
}
# or
if ($line =~ /(\S+)\s+(\S+)/) {
($firstWord, $secondWord) = ($1, $2);
}
$from = "x";
$to = "x.new";
if( -e "$from") { # if file exists
rename($from, $to) || die "Can't rename $from to $to:$!\n";
}
$file = "x";
open(THEFILE,"$file") || die "Couldn't open $file: $!\n";
@fileArray = <THEFILE> ;
foreach $line (@fileArray){
print "Line: $line";
}
$file = "x";
open(THEFILE,"$file") || die "Couldn't open $file: $!\n";
@fileArray = <THEFILE> ;
foreach $line (@fileArray){
@words = split(/\W/, $line); # build a word array
foreach $word (@words){
print "$word ";
}
}
open(FILE,"x") && (@data=<FILE>) && close(FILE) ||
die "Can't process file:$!\n";
print @data;
while(<>){
print if /thepattern/..eof;
}
& copytextFiles("x", "x.bak");
sub copytextFiles {
local($src, $dst) = @_;
open(SRC, $src) || die "Unable to open $src:$!\n";
open(DST,"> $dst") || die "Unable to create $dst:$!\n";
print DST ;
close(SRC);
close(DST);
}
# We could keep the text file in memory
@newText = ("this ", "is ", "new ", "text. ");
$thefile = "x";
open(FILE, "+<$thefile") || die "Can't update $thefile:$!\n";
@orgText = <FILE> ; # read the whole original text in file
seek(FILE,0,0); # rewind
print FILE @newText, @oldText; # write everything
close FILE;
# We can't keep the text file in memory (temp file use)
@newText = ("this ", "is ", "new ", "text. ");
$thefile = "x";
open(IN, $thefile) || die "Can't read $thefile:$!\n";
rename($thefile, "$thefile.bak") || die "Can't rename $thefile:$!\n";
open(OUT, ">$thefile") || die "can't create $thefile:$!\n";
print OUT @newText; # write new text
print OUT while ; # add the original text
close IN;
close OUT;
unlink "$thefile.bak" || die "Can't delete $thefile.bak:$!\n";
$character = 'F'; $count = $line =~ tr/$character//; print "File had $count $character", "\n"; $sentence = "This is a simple sentence"; $letters = $sentence =~ tr/A-Za-z/A-Za-z/; $spaces = $sentence =~ tr/ / /; print "The sentence has $letters letters and $spaces spaces.\n";
$sentence = "This is a simple sentence";
@theletters = split(//, $sentence);
foreach $letter (@theletters){
print("Letter = $letter.\n");
}
sub comparetwofiles {
local ($file1, $file2) = @_;
-e $file1 ||
die "$file1 does not exist: $!\n";
-e $file2 ||
die "$file2 does not exist: $!\n";
($dev1, $ino1, $mode1, $link1, $uid1, $gid1, $rdev1,
$size1, $atime1, $mtime1, $ctime1, $blksize1, $blocks1) =
stat($file1);
($dev2, $ino2, $mode2, $link2, $uid2, $gid2, $rdev2,
$size2, $atime2, $mtime2, $ctime2, $blksize2, $blocks2) =
stat($file2);
# Same size?
if($size1 != $size2){
print "$file1 size = $size1, $file2 size = $size2\n";
}
# Symbolically linked?
if($dev1 == $dev2 && $ino1 == $ino2){
print "$file1 and $file2 are symbolically linked.\n";
}
# Raw byte by byte comparison.
open(FILE1,"$file1") || die "Can't open $file1: $!\n";
open(FILE1,"$file2") || die "Can't open $file2: $!\n";
$blksize = $blocksize1 || 4096;
while( read(FILE2, $file2buf, $blksize)){
read(FILE1, $file1buf, $blksize);
if($file1buf ne $file2buf){
printf "$file1 differs in content from $file2";
}
}
close(FILE1);
close(FILE2);
}
$dir = "/usr/people/foo";
opendir(DIR, $dir) || die "Can't open dir: $!\n";
@filenames = readdir(DIR);
closedir(DIR);
for(@filenames){
print "File = $_ \n";
}
for(@filenames){
if (/.c$/){
print "C code file = $_ \n";
}
}
This could be used for extraction of other strings that are predefined in the mail or posting header.
while(<>) {
last if /^$/;
$subject = $' if/^Subject:/i;
}
die "Can't find Subject: in file\n" if !defined $subject;
print $subject;
$_ = shift(ARGV);
if($_) {
$thefile = $_;
}
else {
print "usage: foo name-of-the-file\n";
exit;
}
print "$thefile\n";
foreach $file (@ARGV) {
&dofile($file);
}
sub dofile {
local ($tmpfile) = @_;
print "$tmpfile ";
}
$PROG = "name-of-this-app";
$VERSION = "1.0";
&Usage;
sub Usage {
select STDOUT;
print << ENDOFLIST
Usage: $PROG [<options>] file ...
Options:
-foo file do something with this file
-help get help information
Description:
$PROG generates something...
Version:
$VERSION
ENDOFLIST
exit 0; # exit if usage is not known
}
Note, this only works on a UNIX system (hostname).
chop($myhostname = `hostname`);
($systemname, $aliases, $addrtype, $length, @addr)
= gethostbyname($myhostname);
print "System = $systemname, aliases = $aliases,
address type = $addrtype .\n";